home *** CD-ROM | disk | FTP | other *** search
- /************************************************************************
- * *
- * The SB-Prolog System *
- * Copyright SUNY at Stony Brook, 1986; University of Arizona,1987 *
- * *
- ************************************************************************/
-
- /*-----------------------------------------------------------------
- SB-Prolog is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY. No author or distributor
- accepts responsibility to anyone for the consequences of using it
- or for whether it serves any particular purpose or works at all,
- unless he says so in writing. Refer to the SB-Prolog General Public
- License for full details.
-
- Everyone is granted permission to copy, modify and redistribute
- SB-Prolog, but only under the conditions described in the
- SB-Prolog General Public License. A copy of this license is
- supposed to have been given to you along with SB-Prolog so you
- can know your rights and responsibilities. It should be in a
- file named COPYING. Among other things, the copyright notice
- and this notice must be preserved on all copies.
- ------------------------------------------------------------------ */
-
- /****************************************************************************
- * *
- * This file has been changed by to include Modules Extensions *
- * Changes by : Brian Paxton 1991/92 *
- * Last update : June 1992 *
- * *
- * Organisation : University of Edinburgh. *
- * For : Departments of Computer Science and Artificial Intelligence *
- * Fourth Year Project. *
- * *
- ****************************************************************************/
-
- $currsym_export([$current_predicate/2,$current_predicate/3,
- $predicate_property/2,
- $predicate_property/3, $current_functor/2,
- $current_functor/3,$current_atom/1,$current_atom/2,
- $pervasive/1, $pervasive0/1,
- $pervasive_function/1, $pervasive_function0/1,
- $pervasive_predicate/1, $pervasive_predicate0/1,
- $functor_name/1,$structure_name/1,
- $signature_name/1,$current_function/2,$current_function/3]).
-
- % $currsym_use : $buff $bmeta
-
- % The following batch of predicate all return the contents of the database
- % on backtracking. Only those listed with user level equivalents are
- % available to the user.
-
- % On backtracking gives all predicates in database (not system ones).
- % Only current_predicate/2 available at user level.
-
- $current_predicate(X,Y) :- $current_predicate(X,Y,_,0).
- $current_predicate(X,Y,ShowAll) :- $current_predicate(X,Y,_,ShowAll).
-
- % Returns the type of the predicate (interpreted/compiled).
- % predicate_property/2 at user level.
-
- $predicate_property(Pred,Prop) :- $predicate_property(Pred,Prop,0).
-
- $predicate_property(Pred,interpreted,ShowAll) :-
- $current_predicate(_,Pred,1,ShowAll).
- $predicate_property(Pred,compiled,ShowAll) :-
- $current_predicate(_,Pred,2,ShowAll).
-
- $current_predicate(X,Y,Type,ShowAll) :-
- (Type = 1 /* asserted */ ; Type = 2 /* compiled */ ),
- (var(Y) ->
- ($current_symbol(0,0,Type,0,X0,Y),
- ((nonvar(X) ; ShowAll > 0) ->
- true ;
- ($external_symbol(X0), not($internal_pred(Y)))
- ),
- X0 = X
- ) ;
- ($symtype(Y, Type),
- $functor0(Y,X)
- )
- ).
-
- % Returns all functions (including atoms) on backtracking.
- % Only current_function/2 available at user level.
-
- $current_function(X,Y) :-
- $current_function(X,Y,0).
-
- $current_function(X,X,Z) :-
- $current_atom(X,Z).
-
- $current_function(X,Y,ShowAll) :-
- (var(Y) ->
- ($current_symbol(0,0,0,0,X0,Y),
- ((nonvar(X) ; ShowAll > 0) ->
- true ;
- ($external_symbol(X0), not($internal_func(Y)))
- ),
- X0 = X
- ) ;
- ($symtype(Y, Type),
- $functor0(Y,X)
- )
- ).
-
- $current_functor(X,Y) :- $current_functor(X,Y,0).
-
- $current_functor(X,Y,ShowAll) :-
- $current_symbol(0,0,0,0,X0,Y0),
- (ShowAll > 0 ->
- true ;
- $external_symbol(X0)
- ),
- X0 = X,
- Y0 = Y.
- $current_functor(X,Y,ShowAll) :- $current_predicate(X,Y,ShowAll).
-
- % Returns all atoms on backtracking.
- % current_atom/1 at user level.
-
- $current_atom(X) :- $current_atom(X,0).
-
- $current_atom(X,ShowAll) :-
- $current_symbol(0,0,0,0,X0,_),
- (ShowAll > 0 ->
- true ;
- ( $external_symbol(X0), not($internal_func(X0)) )
- ),
- $atom(X0),
- X = X0.
-
- $current_symbol(CurrBucket,CurrElt,Type,OldP,X,Y) :-
- $stlookup(CurrBucket,CurrElt,Type,OldP,NewBucket,NewElt,Psc),
- (($mkstr(Psc,Y,_),
- $functor0(Y,X)
- ) ;
- $current_symbol(NewBucket,NewElt,Type,1,X,Y)
- ).
-
- $stlookup(A,B,C,D,E,F,G) :- '_$builtin'(14).
-
- /* a symbol is considered an external symbol if its name does not begin
- with $ or _$.
- */
-
- $external_symbol(X) :-
- $name(X,Xname),
- not( (Xname = [0'$ | _] ;
- Xname = [0'_, 0'$|_]
- )
- ).
-
- /* The following define the contents of the pervasives signature. */
- /* All available at user level */
-
- $pervasive_function(Name/Arity) :-
- $atom(Name), $integer(Arity),
- $bldstr(Name,Arity,Term),
- $pervasive_function0(Term).
-
- $pervasive_function0(Term) :-
- ( $atom(Term) -> true ; $structure(Term) ),
- $functor0(Term,Name),
- ( not($external_symbol(Name)) ;
- $internal_func(Term) ),!.
-
- $pervasive_predicate(Name/Arity) :-
- $atom(Name), $integer(Arity),
- $bldstr(Name,Arity,Term),
- $pervasive_predicate0(Term).
-
- $pervasive_predicate0(Term) :-
- ( $atom(Term) -> true ; $structure(Term) ),
- $functor0(Term,Name),
- ( not($external_symbol(Name)) ;
- $internal_pred(Term) ),!.
-
- $pervasive(Name/Arity) :-
- $atom(Name), $integer(Arity),
- $bldstr(Name,Arity,Term),
- $pervasive0(Term).
-
- $pervasive0(Term) :-
- ( $atom(Term) -> true ; $structure(Term) ),
- $functor0(Term,Name),
- ( not($external_symbol(Name)) ;
- $internal_pred(Term) ;
- $internal_func(Term) ),!.
-
- /* Find names of module constructs. */
- /* All available at user level */
-
- $functor_name(X) :-
- $symtype($module_functor(_,_,_,_,_,_,_,_,_,_),Type),
- Type > 0,
- $setof(Name, Name^D1^D2^D3^D4^D5^D6^D7^D8^D9^
- $module_functor(Name,D1,D2,D3,D4,D5,D6,D7,D8,D9), List),
- $member(X, List).
-
- $structure_name(X) :-
- $symtype($module_structure(_,_,_,_,_),Type),
- Type > 0,
- $setof(Name, Name^D1^D2^D3^D4^
- $module_structure(Name,D1,D2,D3,D4), List),
- $member(X, List).
-
- $signature_name(X) :-
- $symtype($module_signature(_,_,_,_,_),Type),
- Type > 0,
- $setof(Name, Name^D1^D2^D3^D4^
- $module_signature(Name,D1,D2,D3,D4), List),
- $member(X, List).
-
-
- % THE PREDICATES
-
- % File : $bio.P
- $internal_pred(writename(_)).
- $internal_pred(writeqname(_)).
- $internal_pred(put(_)).
- $internal_pred(nl).
- $internal_pred(tab(_)).
- $internal_pred(tell(_)).
- $internal_pred(tell(_,_)).
- $internal_pred(telling(_)).
- $internal_pred(told).
- $internal_pred(get(_)).
- $internal_pred(get0(_)).
- $internal_pred(see(_)).
- $internal_pred(seeing(_)).
- $internal_pred(seen).
-
- % File : $io.P
- $internal_pred(write(_)).
- $internal_pred(writeq(_)).
- $internal_pred(display(_)).
- $internal_pred(print(_)).
- $internal_pred(print_al(_,_)).
- $internal_pred(print_ar(_,_)).
- $internal_pred(errmsg(_)).
-
- % File : $assert.P
- $internal_pred(assert(_)).
- $internal_pred(asserta(_)).
- $internal_pred(asserta(_,_)).
- $internal_pred(assertz(_)).
- $internal_pred(assertz(_,_)).
- $internal_pred(assert(_,_)).
- $internal_pred(asserti(_,_)).
- $internal_pred(assert(_,_,_,_)).
- $internal_pred(assert_union(_,_)).
- $internal_pred(assert(_,_,_)).
- $internal_pred(asserta(_,_,_)).
- $internal_pred(assertz(_,_,_)).
- $internal_pred(asserti(_,_,_)).
-
- % File : $bmeta.P
- $internal_pred(atom(_)).
- $internal_pred(atomic(_)).
- $internal_pred(integer(_)).
- $internal_pred(number(_)).
- $internal_pred(arg(_,_,_)).
- $internal_pred(compound_term(_)).
- $internal_pred(arity(_,_)).
- $internal_pred(real(_)).
- $internal_pred(float(_)).
- $internal_pred(is_buffer(_)).
- $internal_pred(bldstr(_,_,_,_)). % Processed by $funrel.P for extra arg
- $internal_pred(function(_)).
- $internal_pred(predicate(_)).
-
- % File : $meta.P
- $internal_pred(length(_,_)).
- $internal_pred('=..'(_,_,_)). % Processed by $funrel.P for extra arg
- $internal_pred(compound(_,_,_,_)). % Processed by $funrel.P for extra arg
-
- % File : $name.P
- $internal_pred(name(_,_,_)). % Processed by $funrel.P for extra arg
-
- % File : $read.P
- $internal_pred(read(_,_)). % Processed by $funrel.P for extra arg
- $internal_pred(read(_,_,_)). % Processed by $funrel.P for extra arg
-
- % File : $inlines.P
- $internal_pred('='(_,_)).
- $internal_pred('<'(_,_)).
- $internal_pred('=<'(_,_)).
- $internal_pred('>='(_,_)).
- $internal_pred('>'(_,_)).
- $internal_pred('=:='(_,_)).
- $internal_pred('=\='(_,_)).
- $internal_pred(is(_,_)).
- $internal_pred(eval(_,_)).
- $internal_pred(var(_)).
- $internal_pred(nonvar(_)).
- $internal_pred(fail).
- $internal_pred(true).
- $internal_pred(halt).
- $internal_pred('?='(_,_)).
- $internal_pred('\='(_,_)).
-
- % File : $osys.P
- $internal_pred(cputime(_)).
- $internal_pred(syscall(_,_,_)).
- $internal_pred(system(_)).
-
- % File : $glob.P
- $internal_pred(globalset(_)).
- $internal_pred(gennum(_)).
- $internal_pred(gensym(_,_)).
-
- % File : $compare.P
- $internal_pred('=='(_,_)).
- $internal_pred('\=='(_,_)).
- $internal_pred('@=<'(_,_)).
- $internal_pred('@<'(_,_)).
- $internal_pred('@>'(_,_)).
- $internal_pred('@>='(_,_)).
- $internal_pred(compare(_,_,_)).
-
- % File : $deb.P
- $internal_pred(debug).
- $internal_pred(nodebug).
- $internal_pred(trace(_)).
- $internal_pred(untrace(_)).
- $internal_pred(spy(_)).
- $internal_pred(nospy(_)).
- $internal_pred(trace).
- $internal_pred(untrace).
- $internal_pred(debugging).
- $internal_pred(tracepreds(_)).
- $internal_pred(spypreds(_)).
-
- % File : $retr.P
- $internal_pred(retract(_)).
- $internal_pred(abolish(_)).
- $internal_pred(abolish(_,_)).
- $internal_pred(retractall(_)).
- $internal_pred(retract(_,_)).
- $internal_pred(retractall(_,_)).
-
- % File : $consult.P
- $internal_pred(consult(_)).
- $internal_pred(consult(_,_)).
- $internal_pred(consult(_,_,_)).
-
- % File : $buff.P (found in $readloop.P)
- $internal_pred(alloc_perm(_,_)).
- $internal_pred(alloc_heap(_,_)).
- $internal_pred(trimbuff(_,_,_)).
- $internal_pred(symtype(_,_)).
- $internal_pred(substring(_,_,_,_,_,_)).
- $internal_pred(subnumber(_,_,_,_,_,_)).
- $internal_pred(subdelim(_,_,_,_,_,_)).
- $internal_pred(conlength(_,_)).
- $internal_pred(pred_undefined(_)).
- $internal_pred(hashval(_,_,_)).
-
- % File : $defint.P
- $internal_pred(defint_call(_,_,_,_)).
-
- % File : $setof.P
- $internal_pred(setof(_,_,_)).
- $internal_pred(bagof(_,_,_)).
- $internal_pred(findall(_,_,_)).
- $internal_pred(sort(_,_)).
- $internal_pred(keysort(_,_)).
- $internal_pred('^'(_,_)).
-
- % File : $compile.P
- $internal_pred(compile).
- $internal_pred(compile(_)).
- $internal_pred(compile(_,_)).
- $internal_pred(compile(_,_,_)).
- $internal_pred(compile(_,_,_,_)).
-
- % File : $getclauses.P
- $internal_pred(getclauses(_,_)).
- $internal_pred(getclauses(_,_,_)).
- $internal_pred(attach(_,_)).
- $internal_pred(expand_term(_,_)).
-
- % File : $prag.P
- $internal_pred(get_prag(_,_)).
-
- % File : $blist.P
- $internal_pred(append(_,_,_)).
- $internal_pred(member(_,_)).
-
- % File : $listutil1.P
- $internal_pred(reverse(_,_)).
- $internal_pred(merge(_,_,_)).
- $internal_pred(absmember(_,_)).
- $internal_pred(absmerge(_,_,_)).
- $internal_pred(closetail(_)).
- $internal_pred(nthmember(_,_,_)).
-
- % File : $arith.P
- $internal_pred(floatc(_,_,_)).
- $internal_pred(exp(_,_)).
- $internal_pred(square(_,_)).
- $internal_pred(sin(_,_)).
- $internal_pred(floor(_,_)).
-
- % File : $prof.P
- $internal_pred(count(_)).
- $internal_pred(time(_)).
- $internal_pred(nocount(_)).
- $internal_pred(notime(_)).
- $internal_pred(profiling).
- $internal_pred(prof_reset(_)).
- $internal_pred(resetcount(_)).
- $internal_pred(resettime(_)).
- $internal_pred(profile).
- $internal_pred(noprofile).
- $internal_pred(timepreds(_)).
- $internal_pred(countpreds(_)).
- $internal_pred(prof_stats(_)).
- $internal_pred(prof_stats).
-
- % File : $stat.P
- $internal_pred(statistics).
- $internal_pred(statistics(_,_)).
-
- % File : $dcg.P
- $internal_pred(dcg(_,_)).
- $internal_pred(phrase(_,_)).
- $internal_pred(phrase(_,_,_)).
- $internal_pred('C'(_,_,_)).
-
- % File : $portray.P
- $internal_pred(portray_term(_)).
- $internal_pred(portray_clause(_)).
-
- % File : $decompile.P
- $internal_pred(clause(_,_)).
- $internal_pred(clause(_,_,_)).
- $internal_pred(listing(_)).
- $internal_pred(instance(_,_)).
- $internal_pred(listing).
- $internal_pred(list_module(_)).
-
- % File : $record.P
- $internal_pred(erase(_)).
- $internal_pred(recorda(_,_,_)).
- $internal_pred(recordz(_,_,_)).
- $internal_pred(recorded(_,_,_)).
-
- % File : $currsym.P
- $internal_pred(current_predicate(_,_)).
- $internal_pred(predicate_property(_,_)).
- $internal_pred(current_atom(_)).
- $internal_pred(pervasive(_)).
- $internal_pred(pervasive0(_)).
- $internal_pred(pervasive_function(_)).
- $internal_pred(pervasive_function0(_)).
- $internal_pred(pervasive_predicate(_)).
- $internal_pred(pervasive_predicate0(_)).
- $internal_pred(functor_name(_)).
- $internal_pred(structure_name(_)).
- $internal_pred(signature_name(_)).
- $internal_pred(current_function(_,_)).
-
- % File : $modules.P
- $internal_pred(dismantle_name(_,_,_)).
- $internal_pred(current_structure(_,_)). % Processed by $funrel.P for extra arg
- $internal_pred(structure(_,_,_)). % Processed by $funrel.P for extra arg
- $internal_pred(structure(_,_,_,_)). % Processed by $funrel.P for extra arg
-
- % File : $call.P
- $internal_pred(','(_,_)).
- $internal_pred(','(_,_,_,_)).
- $internal_pred(';'(_,_)).
- $internal_pred('->'(_,_)).
- $internal_pred(not(_)).
- $internal_pred('\+'(_)).
- $internal_pred(call(_)).
- $internal_pred(call(_,_)).
-
- % File : $readloop.P
- $internal_pred(break).
- $internal_pred(abort).
- $internal_pred(repeat).
- $internal_pred(loaded_mods(_)).
- $internal_pred(defined_mods(_,_)).
- $internal_pred(load(_)).
-
- % Other bits
-
- $internal_pred('!').
-
- % The following predicates are defined in the /lib directory
-
- $internal_pred(access(_,_)).
- $internal_pred(access(_,_,_)).
- $internal_pred(call_ref(_,_)).
- $internal_pred(call_ref(_,_,_)).
- $internal_pred(emode(_,_,_)).
- $internal_pred(errno(_)).
- $internal_pred(flags(_,_)).
- $internal_pred(index(_,_,_)).
- $internal_pred(mode(_)).
- $internal_pred(mode(_,_,_)).
- $internal_pred(nodynload(_,_)).
- $internal_pred(op(_,_,_)).
- $internal_pred(restore(_)).
- $internal_pred(save(_)).
- $internal_pred(exists(_)).
- $internal_pred(subsumes(_,_)).
-
- % The following are pervasive predicates, but do not have a Prolog definition!
- % ie. those that require the extra current structure tag argument which is
- % added in by $funrel.P
-
- $internal_pred(current_structure(_)).
- $internal_pred(name(_,_)).
- $internal_pred(read(_)).
- $internal_pred(compound(_,_,_)).
- $internal_pred(bldstr(_,_,_)).
- $internal_pred('=..'(_,_)).
- $internal_pred(structure(_,_)).
-
- % THE FUNCTIONS
-
- % Clause forms/etc.
- % Note: Stuff like ; , -> are defined as predicates!
- % This list is not exhaustive - cannot possibly show all error messages, etc.
-
- $internal_func('[]').
- $internal_func('.'(_,_)).
- $internal_func('::-'(_,_)).
- $internal_func(':-'(_)).
- $internal_func(':-'(_,_)).
-
- % Dcg :
-
- $internal_func('-->'(_,_)).
- $internal_func('{}').
- $internal_func('{}'(_)).
-
- % Operators :
-
- $internal_func(fx).
- $internal_func(xfx).
- $internal_func(fy).
- $internal_func(xfy).
- $internal_func(yfx).
- $internal_func(xf).
- $internal_func(yf).
-
- % Files :
-
- $internal_func(stderr).
- $internal_func(end_of_file).
- $internal_func(user).
-
- % Statistics :
-
- $internal_func(runtime).
- $internal_func(core).
- $internal_func(memory).
- $internal_func(stack_shifts).
- $internal_func(heap).
- $internal_func(program).
- $internal_func(global_stack).
- $internal_func(local_stack).
- $internal_func(trail).
- $internal_func(garbage_collection).
-
- % Predicate types :
-
- $internal_func(interpreted).
- $internal_func(compiled).
-
- % Compare :
-
- $internal_func('<').
- $internal_func('>').
- $internal_func('=').
-
-
- % Mathematical :
-
- $internal_func('/'(_,_)).
- $internal_func('-'(_,_)).
- $internal_func('<<'(_,_)).
- $internal_func('+'(_,_)).
- $internal_func('-'(_)).
- $internal_func('+'(_)).
- $internal_func('//'(_,_)).
- $internal_func('\/'(_,_)).
- $internal_func('>>'(_,_)).
- $internal_func('/\'(_,_)).
- $internal_func('*'(_,_)).
- $internal_func('\'(_)).
- $internal_func(mod(_,_)).
- $internal_func(sqrt(_)).
- $internal_func(square(_)).
- $internal_func(arcsin(_)).
- $internal_func(integer(_)).
- $internal_func(float(_)).
- $internal_func(exp(_)).
- $internal_func(ln(_)).
- $internal_func(sin(_)).
-
- % Compile/consult/etc arguments :
-
- $internal_func('++').
- $internal_func(t).
- $internal_func('?').
- $internal_func(v).
- $internal_func(nv).
- $internal_func(a).
- $internal_func(c).
- $internal_func(d).
- $internal_func(e).
- $internal_func(s).
- $internal_func('+').
- $internal_func('-').
-
- % Others
-
- $internal_func(':'(_,_)).
- $internal_func('/'(_,_)).
- $internal_func(perv).
- $internal_func(sharing(_,_)).
- $internal_func(inherit(_)).
- $internal_func(pred(_)).
- $internal_func(fun(_)).
- $internal_func(functor(_)).
- $internal_func(structure(_)).
- $internal_func(signature(_)).
- $internal_func(struct(_)).
- $internal_func(sig(_)).
- $internal_func(and(_,_)).
-
- /* ------------------------------ $currsyms.P ------------------------------ */
-
-